;;;; 2008-06-26 16:05:29
;;;; A bag of general utility functions operating on lists and muti-dim arrays
;;;; Author: Trystan A Larey-Williams 

(in-package :lisp-utils)

(defun distance (u v)
  "Reurns a number representing the absolute distance between two vectors (represented as lists)."
  (sqrt (reduce #'+ (mapcar (lambda (a b)
                              (* (- a b) (- a b)))
                            u v))))

(defun inc-list (lst num)
  "Increment every element in lst by num"
  (mapcar (lambda (a) (+ a num)) lst))


(defun dec-list (lst num)
  "Decrement every element in lst by num"
  (mapcar (lambda (a) (- a num)) lst))


(defun inc-index-list (base lst)
  "Increments a list of subscripts relative to a list of number-place bases 
   returns new list if incremented or nil if lst is already maxed."
  (if (car lst)
      (if (< (+ (car lst) 1) (car base))
          (cons (+ (car lst) 1) (cdr lst))
          (let ( (retVal (inc-index-list (cdr base) (cdr lst))) )
            (if retVal
                (cons 0 retVal)
                nil)))
      nil))
 

(defun make-counter (base places)
  "Builds a function that is a closure over a counter for the given number base with
the given number of places." 
  (let ((counter (make-list places :initial-element 0))
        (limit (make-list places :initial-element base)))
    (lambda ()
      (let ((old counter))
      (setf counter (inc-index-list limit counter))
      old))))


(defun maparray (a fun)
  "Applies function 'fun' to each element of array 'a' and return a new array of
   idendical dimensions of 'a' as a result."
  (let ( (dim (array-dimensions a)) ) 
    (labels ((map-internal (new-array index)
               (setf (apply #'aref new-array index) 
                     (funcall fun (apply #'aref a index)))
               (let ( (i (inc-index-list dim index)) )
                 (if i
                     (map-internal new-array i)
                     new-array))))
      (map-internal (make-array dim :initial-element 0) 
                    (make-list (array-rank a) :initial-element 0)))))


(defun list-integer-midpoint (lst)
  (mapcar (lambda (e)
            (if (eql e 0)
                0
                (truncate e 2)))
          lst))


(defun array-center (a)
  "Return a list representing the center of an n dimensional array a."
  (list-integer-midpoint (array-dimensions a)))


(defun array-random-op (a fun)
  "Destructively apply operation given by fun to a random element of an n dimensional array a." 
  (let ((index (mapcar (lambda (c) 
                         (random c)) 
                       (array-dimensions a))))
    (setf (apply #'aref a index) (funcall fun (apply #'aref a index)))
    nil ))


(defun random-object (&rest objects)
  "Return a random object from a sequence of objects." 
  (nth (random (length objects)) objects))


(defun list-random-op (lst fun)
  "Non-destructively apply operation given by fun to a random element in the list lst."
  (let ( (index (random (length lst))) )
    (replace (copy-seq lst) (list (funcall fun (nth index lst))) :start1 index )))


(defun interval-rand (l h)
  "Returns a random integer on the interval (l, h)."
  (+ (+ (random (- (- h l) 1)) l) 1))


(defun interleave (m n)
  "Interleave the contents of lists m and n and return resulting list."
  (if (and (car m) (car n))
      (append (cons (car m) (list (car n))) (interleave (cdr m) (cdr n)))
      (if (car m)
          m
          (if (car n) 
              n
              nil))))


(defun first-that-is (lst condition &optional (itr 0))
  "Returns the index of the first element of lst meeting condition."
  (if (funcall condition (car lst))
      itr
      (first-that-is (cdr lst) condition (+ itr 1))))


(defun insert (lst item index)
  "Return a copy of lst where item is inserted into lst at index."
  (if (> index 0)
      (cons (car lst) (insert (cdr lst) item (- index 1)))
      (cons item lst)))

(defun remove-at (lst index)
  "Return a copy of lst where the element at index is removed from lst."
  (if (eql index 0)
      (cdr lst)
      (cons (car lst) (remove-at (cdr lst) (- index 1)))))

(defun space-partition-along (a axis val lower-bound upper-bound)
  "Destructively set an entire axis of an n dimensional array's values given by a to val. For example, for a 3
  dimensional array with axis equal to '(~ 2 ~), the function will hold y constant at 2 and cycle all possible
  x/z indecies setting them to val; effectively visiting all positions on a discrete x/z plane."  
  (let*  ((place (first-that-is axis (lambda (a) (not (eql a #\~)))))
          (along (nth place axis)) 
          (extent (mapcar (lambda (a) (+ a 1)) (remove-at upper-bound place))))
    (labels ((set-vals (places)
               (if places
                   (setf (apply #'aref a (insert places along place)) val))
               (if places
                   (set-vals (inc-index-list extent places)))))
      (set-vals (remove-at lower-bound place)))))


(defun left-rotate-list (lst)
  "Return copy of lst where all elements in lst are shifted by one position left.
  The leftmost element will become the rightmost."
  (append (remove (car lst) lst :count 1) (list (car lst))))


(defun all-rotations (lst)
  "Return a new list containing (length lst) number of lists representing all possible
 rotations of lst, e.g. '(1 2) -> '((1 2) (2 1))."
  (let ((len (length lst)))
    (labels ((inner (lst itr)
               (let ((rotation (left-rotate-list lst)))
                 (if (< itr len)
                     (cons rotation (inner rotation (+ itr 1)))
                     '()))))
      (inner lst 0))))


(defun pick-from-lists (indexes &rest lists)
  "Takes a list of integers representing the index of a list and builds a list of 
values x where the car of x is the car of (nth (car indexes) lists), 
the caar of x is the caar of (nth (caar indexes) lists) and so forth for all indexes."
  (let ((offset (length indexes)))
    (labels ((pick (indxs)
               (if (eql indxs nil)
                   '()
                   (cons (nth (abs (- (length indxs) offset)) (nth (car indxs) lists)) 
                         (pick (cdr indxs))))))
      (pick indexes))))


(defun combine-interchanges (&rest lists)
  "Returns a set of lists representing every possible in-place combination of the list
arguments"
  (let ((counter (make-counter (length lists) (length (car lists)))))
    (labels ((walk-counter ()
               (let ((val (funcall counter)))
                 (if (eql val nil)
                     '()
                     (cons (apply #'pick-from-lists val lists) (walk-counter))))))
      (walk-counter))))

